unit PlugIns; {This unit for utilizing Adobe Photoshop compatible acquisition, export and filter plug-ins} {is based on code written by Greg Brown, Steven Gonzalo and Richard Ohlendorf.} {Ohlendorf Research, Inc.} {818 LaSalle Street} {Ottawa, IL 61350} {815-434-5622} {Applelink--Abraham@AppleLink.com} interface uses Memory, QuickDraw, Packages, Menus, Events, Fonts, Scrap, ToolUtils, Resources, Errors, Palettes, QDOffscreen, StandardFile, MixedMode, Globals, utilities, Graphics, Lut, Filters, Stacks, File1, File2 {$ifc PowerPC} , glue {$endc} ; procedure RunAcqPlugIn (item: integer); procedure LoadAcqPlugIn (FileName: str255); procedure RunExportPlugIn (item: integer); procedure LoadExportPlugIn (FileName: str255); procedure RunFilterPlugIn (item: integer); procedure LoadFilterPlugIn (FileName: str255); implementation const uppCallCodeInfo = $00003F80; { PROCEDURE (2 byte param, 4 byte param, 4 byte param, 4 byte param); } uppTestAbortProcInfo = $00000011; { FUNCTION : 1 byte result; } uppUpdateProgressProcInfo = $000003C0; { PROCEDURE (4 byte param, 4 byte param); } type PluginCodeType=procedure(selector: integer; AcqRec: ptr; var data: LongInt; var result: Integer); MonitorRec = record gamma: Fixed; redX: Fixed; redY: Fixed; greenX: Fixed; greenY: Fixed; blueX: Fixed; blueY: Fixed; whiteX: Fixed; whiteY: Fixed; ambient: Fixed; end; PlaneMapType = array[0..15] of integer; AcquireRecord = record serialNumber: LongInt; abortProc: ProcPtr; progressProc: ProcPtr; maxData: LongInt; imageMode: integer; fImageSize: Point; depth: integer; planes: integer; imageHRes: Fixed; imageVRes: Fixed; rLUT: packed array[0..255] of char; gLUT: packed array[0..255] of char; bLUT: packed array[0..255] of char; data: Ptr; theRect: Rect; loPlane: integer; hiPlane: integer; colBytes: integer; rowBytes: LongInt; planeBytes: LongInt; FileName: Str255; vRefNum: integer; dirty: boolean; {Version 4 fields} hostSig: OSType; hostProc: ProcPtr; hostModes: LongInt; planeMap: PlaneMapType; canTranspose: boolean; needTranspose: boolean; duotoneInfo: Handle; diskSpace: LongInt; spaceProc: ProcPtr; monitor: MonitorRec; reserved: packed array[0..255] of char; end; FilterColor = packed array[0..3] of char; FilterRecord = record serialNumber: LongInt; abortProc: ProcPtr; progressProc: ProcPtr; parameters: Handle; fImageSize: Point; planes: integer; filterRect: Rect; background: RGBColor; foreground: RGBColor; maxSpace: LongInt; bufferSpace: LongInt; inRect: Rect; inLoPlane: integer; inHiPlane: integer; outRect: Rect; outLoPlane: integer; outHiPlane: integer; inData: Ptr; inRowBytes: LongInt; outData: Ptr; outRowBytes: LongInt; isFloating: boolean; haveMask: boolean; autoMask: boolean; maskRect: Rect; maskData: Ptr; maskRowBytes: LongInt; {Version 4 fields} backColor: FilterColor; foreColor: FilterColor; hostSig: OSType; hostProc: ProcPtr; imageMode: integer; imageHRes: Fixed; imageVRes: Fixed; floatCoord: Point; wholeSize: Point; monitor: MonitorRec; reserved: packed array[0..255] of char; end; ExportRecord = record serialNumber: LongInt; abortProc: ProcPtr; progressProc: ProcPtr; maxData: LongInt; imageMode: integer; eImageSize: Point; depth: integer; planes: integer; imageHRes: Fixed; imageVRes: Fixed; rLUT: packed array[0..255] of char; gLUT: packed array[0..255] of char; bLUT: packed array[0..255] of char; theRect: Rect; loPlane: integer; hiPlane: integer; data: Ptr; rowBytes: LongInt; filename: Str255; vRefNum: integer; dirty: BOOLEAN; selectBBox: Rect; {Version 4 fields } hostSig: OSType; hostProc: ProcPtr; duotoneInfo: Handle; thePlane: integer; monitor: MonitorRec; reserved: packed array[0..255] of char; end; function ForceToFront: OSErr; { AE - RMD 1/10/95 } forward; var acqData, exportData, filterData, nlines, rowpix: LongInt; disppict, srcpict: ptr; refnum: integer; ShowProgress: boolean; ProgressMsg: string[17]; FilterRec: FilterRecord; PluginCode:PluginCodeType; procedure DummyProc; begin end; function TestAbort: boolean; begin if commandperiod then testabort := true else testabort := false; end; procedure UpdateProgress (done, total: LongInt); var whatpercent: integer; begin if ShowProgress and (done > 0) and (total > 0) and (total >= done) then begin whatpercent := round((done / total) * 100); UpdateMeter(whatpercent, ProgressMsg); end; end; procedure CopyData (src: ptr; theRect: rect; srcRowBytes, dstRowBytes: LongInt; lines: integer); var i: integer; dst: ptr; width: LongInt; begin with theRect do width := right - left; with info^ do dst := ptr(ord4(PicBaseAddr) + therect.top * BytesPerRow + therect.left); for i := 0 to lines - 1 do begin BlockMove(src, dst, width); src := ptr(ord4(src) + srcRowBytes); dst := ptr(ord4(dst) + dstRowBytes); end; end; procedure CopyInterleavedRGBData (src: ptr; theRect: rect; srcRowBytes, dstRowBytes, colBytes: LongInt; lines: integer; planeMap: PlaneMapType); var i, j, slice, plane, width: integer; src2, src3, dst2, dst3: ptr; begin with theRect do width := right - left; with info^.StackInfo^ do for slice := 1 to 3 do begin CurrentSlice := slice; SelectSlice(slice); plane := planeMap[slice - 1]; src2 := src; dst2 := ptr(ord4(info^.PicBaseAddr) + therect.top * info^.BytesPerRow + therect.left); for i := 0 to lines - 1 do begin src3 := ptr(ord4(src2) + plane); dst3 := dst2; for j := 0 to width - 1 do begin dst3^ := src3^; src3 := ptr(ord4(src3) + colBytes); dst3 := ptr(ord4(dst3) + 1); end; src2 := ptr(ord4(src2) + srcRowBytes); dst2 := ptr(ord4(dst2) + dstRowBytes); end; {for i:=1 to nlines-1} end; {for slice:=1 to 3} end; procedure CopyPlanarRGBData (src: ptr; theRect: rect; srcRowBytes, dstRowBytes, planeBytes: LongInt; lines, loPlane, hiPlane: integer); var i, j, slice, plane: integer; src2, dst2: ptr; width: LongInt; begin with theRect do width := right - left; if loPlane = hiPlane then planeBytes := 0; if (planeBytes < 0) or (planeBytes > srcRowBytes) then planeBytes := width; with info^.StackInfo^ do for plane := loPlane to hiPlane do begin slice := plane + 1; if slice > 3 then slice := 3; CurrentSlice := slice; SelectSlice(slice); src2 := ptr(ord4(src) + planeBytes * plane); dst2 := ptr(ord4(info^.PicBaseAddr) + therect.top * info^.BytesPerRow + therect.left); for i := 0 to lines - 1 do begin BlockMove(src2, dst2, width); src2 := ptr(ord4(src2) + srcRowBytes); dst2 := ptr(ord4(dst2) + dstRowBytes); end; end; end; function MakeRGBStack (name: str255; width, height: integer): boolean; var ignore: integer; begin MakeRGBStack := false; if not NewPicWindow('RGB', width, height) then exit(MakeRGBStack); if not MakeStackFromWindow then exit(MakeRGBStack); if not AddSlice(false) then begin info^.changes := false; ignore := CloseAWindow(info^.wptr); exit(MakeRGBStack); end; if not AddSlice(false) then begin info^.changes := false; ignore := CloseAWindow(info^.wptr); exit(MakeRGBStack); end; MakeRGBStack := true; end; procedure GetSFCurDir (var vRefNum: integer; var DirID: LongInt); {From "Inside Macintosh:Files", page 3-31.} type IntPtr = ^integer; LongIntPtr = ^LongInt; const SFSaveDisk = $214; CurDirStore = $398; begin vRefNum := -IntPtr(SFSaveDisk)^; DirID := LongIntPtr(CurDirStore)^; end; procedure SetSFCurDir (vRefNum: integer; DirID: LongInt); type IntPtr = ^integer; LongIntPtr = ^LongInt; const SFSaveDisk = $214; CurDirStore = $398; begin IntPtr(SFSaveDisk)^ := -vRefNum; LongIntPtr(CurDirStore)^ := dirID; end; function isSystem7: boolean; begin if not System7 then {These routines uses File Manager calls only available under System 7.} PutError('System 7 required to use plug-ins.'); isSystem7 := System7; end; procedure LoadCodeResource (FileName: str255; fType: osType; var codePtr: ProcPtr); var myReply: StandardFileReply; myTypes: SFTypeList; err: OSErr; CodeResource: handle; GotSpec: boolean; spec: FSSpec; SaveVol: integer; SaveDir: LongInt; begin GotSpec := false; if FileName <> '' then begin err := FSMakeFSSpec(PluginsVRefNum, PluginsDirID, FileName, spec); GotSpec := err = noerr; end; if not GotSpec then begin GetSFCurDir(SaveVol, SaveDir); if PluginsVRefNum <> 0 then SetSFCurDir(PluginsVRefNum, PluginsDirID); myTypes[0] := fType; if ForceToFront = noErr then begin { AE - RMD 1/10/95 } StandardGetFile(nil, 1, @myTypes, myReply); if myReply.sfGood then begin spec := myReply.sfFile; FileName := myReply.sfFile.name; GotSpec := true end; end; GetSFCurDir(PluginsVRefNum, PluginsDirID); SetSFCurDir(SaveVol, SaveDir); end; if GotSpec then begin refnum := FSpOpenResFile(spec, fsCurPerm); if (refnum <> -1) then begin if fType = '8BAM' then begin {Acquistion plug-in} if pos('Raster', FileName) <> 0 then {Can't show progress indicator if RasterOps frame grabber.} ShowProgress := false; if FileName <> LastAcqPlugIn then acqData := 0; LastAcqPlugIn := FileName; end else if fType = '8BFM' then begin {Filter plug-in} if FileName <> LastFilterPlugIn then begin filterData := 0; FilterRec.parameters := nil; end; LastFilterPlugIn := FileName; end else if fType = '8BEM' then begin {Export plug-in} if FileName <> LastExportPlugIn then exportData := 0; LastExportPlugIn := FileName; end; UseResFile(refnum); codeResource := GetIndResource(fType, 1); hlock(codeResource); codePtr := ProcPtr(codeResource^); end else PutError(concat('Error opening plug-in. (Code=', Long2Str(ResError), ')')); end; end; {$ifc not PowerPC} procedure CallCode (selector: integer; AcqRec: ptr; var data: LongInt; var result: Integer; codePtr: ptr); inline $205F, {move.l (a7)+,a0} $4E90; {jsr (a0)} {$endc} {Otherwise use C glue routine ("Glue.c") that calls CallUniversalProc. We can't call it directly because CallUniversalProc uses a variable number of arguments.} procedure LoadAcqPlugIn (FileName: str255); const AcquireAbout = 0; AcquireStart = 1; AcquireContinue = 2; AcquireFinish = 3; AcquirePrepare = 4; BitMapMode = 0; GrayScaleMode = 1; IndexedColorMode = 2; RGBColorMode = 3; var thiserror: qderr; codePtr: ProcPtr; AcqRec: acquirerecord; result, i, selector, width, height, ignore: integer; ok: boolean; dst: ptr; name: str255; procedure ShowInfo (str: str255); begin with AcqRec do if ControlKeyDown then begin str := concat(str, crStr, crStr, 'imageMode=', long2str(imageMode)); str := concat(str, crStr, 'width=', long2str(therect.right - therect.left)); str := concat(str, crStr, 'height=', long2str(therect.bottom - therect.top)); str := concat(str, crStr, 'depth=', long2str(depth)); str := concat(str, crStr, 'planes=', long2str(planes)); str := concat(str, crStr, 'colBytes=', long2str(colBytes)); str := concat(str, crStr, 'rowBytes=', long2str(rowBytes)); str := concat(str, crStr, 'planeBytes=', long2str(planeBytes)); str := concat(str, crStr, 'planeMap=', long2str(planeMap[0]), ' ', long2str(planeMap[1]), long2str(planeMap[2]), ' ', long2str(planeMap[3])); str := concat(str, crStr, 'loPlane=', long2str(loPlane)); str := concat(str, crStr, 'hiPlane=', long2str(hiPlane)); ShowMessage(str); wait(30); end; end; procedure CopyLUT; var i: integer; begin with info^ do begin for i := 0 to 255 do with cTable[i], cTable[i].rgb, AcqRec do begin value := 0; red := bsl(ord(rLUT[255 - i]), 8); green := bsl(ord(gLUT[255 - i]), 8); blue := bsl(ord(bLUT[255 - i]), 8); end; LoadLUT(cTable); SetupPseudocolor; LutMode := ColorLUT; IdentityFunction := false; UpdateMap; end end; procedure abort (error: integer; started: boolean); var msg: str255; begin if started then CallCode(AcquireFinish, @AcqRec, acqData, result, codePtr); CloseResFile(RefNum); if MeterWindow <> nil then begin DisposeWindow(MeterWindow); MeterWindow := nil; end; if error < 0 then begin msg := ''; if error = -108 then msg := concat(crStr, crStr, '"', 'Not enough memory', '"'); PutError(concat('Plug-in error (result code=', long2str(error), ')', msg)); end; PicLeft := PicLeftBase; PicTop := PicTopBase; AbortMacro; {exit(LoadAcqPlugIn);} {ppc-bug} end; begin if not isSystem7 then exit(LoadAcqPlugIn); ShowProgress := true; codePtr := nil; LoadCodeResource(FileName, '8BAM', codePtr); if codePtr = nil then exit(LoadAcqPlugIn); if TestAbortProc=nil then TestAbortProc := NewRoutineDescriptor(@TestAbort, uppTestAbortProcInfo, GetCurrentISA); if UpdateProgressProc=nil then UpdateProgressProc := NewRoutineDescriptor(@UpdateProgress, uppUpdateProgressProcInfo, GetCurrentISA); with AcqRec do begin SerialNumber := 12345; AbortProc := TestAbortProc; ProgressProc := UpdateProgressProc; MaxData := maxBlock div 2; if MaxData < 25000 then begin PutError('Out of memory.'); abort(0, false); exit(LoadAcqPlugIn) end; imageHRes := 0; hostSig := 'Imag'; hostProc := nil {@DummyProc}; hostModes := 14;{=1110, i.e., grayscale, indexed color and RGB} for i := 0 to 15 do begin planemap[i] := i; end; FileName := ''; canTranspose := false; needTranspose := false; duoToneInfo := nil; diskSpace := -1; spaceProc := nil; monitor.gamma := 0; for i := 0 to 255 do reserved[i] := chr(0); end; ProgressMsg := 'Acquiring ImageÉ'; ShowInfo('Acquire'); CallCode(AcquirePrepare, @AcqRec, acqData, result, codePtr); if (result <> 0) then begin abort(result, false); exit(LoadAcqPlugIn) end; ShowInfo('start'); CallCode(AcquireStart, @AcqRec, acqData, result, codePtr);{call main dialog box etc.} if (result <> 0) then begin abort(result, false); exit(LoadAcqPlugIn) end; if AcqRec.depth = 1 then begin PutError('NIH Image does not support acquisition of bitmap (black and white) images.'); abort(0, true); exit(LoadAcqPlugIn) end; ShowInfo('Opening'); OpeningPlugInWindow := true; {Causes MakeNewWindow to open window offscreen.} if AcqRec.ImageMode = RGBColorMode then ok := MakeRGBStack('Untitled', AcqRec.fImageSize.h, AcqRec.fImageSize.v) else begin if FileName <> '' then name := FileName else name := 'Untitled'; ok := NewPicWindow(name, AcqRec.fImageSize.h, AcqRec.fImageSize.v); end; OpeningPlugInWindow := false; if not ok then begin ShowInfo('Aborting'); abort(0, true); exit(LoadAcqPlugIn) end; with info^, AcqRec do if ImageMode = GrayScaleMode then begin if LUTMode = ColorLUT then ResetGrayMap end else if ImageMode = RGBColorMode then ResetGrayMap else if ImageMode = IndexedColorMode then begin ShowInfo('CopyLUT'); CopyLUT; end; ShowWatch; ShowInfo('Continue'); repeat CallCode(AcquireContinue, @AcqRec, acqData, result, codePtr); if result <> 0 then begin info^.changes := false; ignore := CloseAWindow(info^.wptr); abort(result, true); exit(LoadAcqPlugIn) end; with AcqRec do if data <> nil then begin width := therect.right - therect.left; height := therect.bottom - therect.top; with Info^ do if ((therect.left + width) <= PixelsPerLine) and (therect.top < nlines) then begin if (ImageMode = RGBColorMode) and (planes >= 3) and ((hiPlane - loPlane) < 3) then begin if planeBytes = 1 then CopyInterleavedRGBData(data, theRect, rowBytes, Info^.BytesPerRow, colBytes, height, planeMap) else CopyPlanarRGBData(data, theRect, rowBytes, Info^.BytesPerRow, planeBytes, height, loPlane, hiPlane) end else CopyData(data, theRect, rowBytes, Info^.BytesPerRow, height); end; end; until (result <> 0) or (AcqRec.data = nil); ShowInfo('Finish'); CallCode(AcquireFinish, @AcqRec, acqData, result, codePtr); CloseResFile(RefNum); if MeterWindow <> nil then begin DisposeWindow(MeterWindow); MeterWindow := nil; end; MoveWindow(info^.wptr, PicLeft, PicTop, true); if AcqRec.imageHRes <> 0 then with info^ do begin xScale := FixRound(AcqRec.imageHRes); yScale := xScale; PixelAspectRatio := 1.0; xUnit := 'inch'; SpatiallyCalibrated := true; UpdateTitleBar; end; if info^.StackInfo <> nil then with info^.StackInfo^ do begin for i := nSlices downto 1 do begin CurrentSlice := i; SelectSlice(CurrentSlice); InvertPic; end; StackType := rgbStack; UpdateTitleBar; ConvertRGBToEightBitColor(true); end else InvertPic; if AcqRec.ImageMode = IndexedColorMode then begin FixColors; WhatToUndo := NothingToUndo; end; Info^.changes := true; end; {LoadAcqPlugIn} procedure PutPlugInMsg (str: str255); var str2: str255; begin if System7 then PutError(concat(str, ' plug-ins found')) {Code Warrior bug} else PutError('System 7 required to use plug-ins.'); end; procedure RunAcqPlugIn (item: integer); var name: str255; begin if nAcqPlugIns = 0 then begin PutPlugInMsg('No acquisition'); exit(RunAcqPlugIn); end; GetMenuItemText(AcquireMenuH, item, name); LoadAcqPlugIn(name); end; procedure LoadExportPlugIn (FileName: str255); const ExportAbout = 0; ExportStart = 1; ExportContinue = 2; ExportFinish = 3; ExportPrepare = 4; BitMapMode = 0; GrayScaleMode = 1; IndexedColorMode = 2; RGBColorMode = 3; var thiserror: qderr; codePtr: ProcPtr; ExportRec: ExportRecord; result, i, selector, width, height: integer; ok: boolean; dst: ptr; roi, empty: rect; offset: LongInt; procedure ShowInfo (str: str255); begin with ExportRec do if ControlKeyDown then begin str := concat(str, crStr, crStr, 'imageMode=', long2str(imageMode)); str := concat(str, crStr, 'width=', long2str(therect.right - therect.left)); str := concat(str, crStr, 'height=', long2str(therect.bottom - therect.top)); str := concat(str, crStr, 'depth=', long2str(depth)); str := concat(str, crStr, 'planes=', long2str(planes)); str := concat(str, crStr, 'rowBytes=', long2str(rowBytes)); str := concat(str, crStr, 'loPlane=', long2str(loPlane)); str := concat(str, crStr, 'hiPlane=', long2str(hiPlane)); ShowMessage(str); end; end; function BadRect: boolean; begin BadRect := false; with info^.PicRect do begin if (ExportRec.theRect.left < left) or (exportRec.theRect.right > right) or (exportRec.theRect.top < top) or (exportRec.theRect.bottom > bottom) then BadRect := true; end; end; procedure abort (result: integer); begin CloseResFile(RefNum); if MeterWindow <> nil then begin DisposeWindow(MeterWindow); MeterWindow := nil; end; InvertPic; if result < 0 then PutError(concat('Plug-in error (result code=', long2str(result), ').')); {exit(LoadExportPlugIn);} {ppc-bug} end; begin if not isSystem7 then exit(LoadExportPlugIn); SetRect(empty, 0, 0, 0, 0); with info^ do if RoiShowing then roi := RoiRect else roi := empty; ShowProgress := true; codePtr := nil; LoadCodeResource(FileName, '8BEM', codePtr); if codePtr = nil then exit(LoadExportPlugIn); if TestAbortProc=nil then TestAbortProc := NewRoutineDescriptor(@TestAbort, uppTestAbortProcInfo, GetCurrentISA); if UpdateProgressProc=nil then UpdateProgressProc := NewRoutineDescriptor(@UpdateProgress, uppUpdateProgressProcInfo, GetCurrentISA); InvertPic; with ExportRec, info^ do begin SerialNumber := 12345; AbortProc := TestAbortProc; ProgressProc := UpdateProgressProc; MaxData := maxBlock div 2; if MaxData < 25000 then begin PutError('Out of memory.'); abort(0); exit(LoadExportPlugIn); end; if LUTMode = Grayscale then ImageMode := GrayScaleMode else ImageMode := IndexedColorMode; with PicRect, eImageSize do begin h := right - left; v := bottom - top; end; depth := 8; planes := 1; imageHRes := bsl(72, 16); imageVRes := imageHRes; for i := 0 to 255 do with cTable[i].rgb do begin rLUT[255 - i] := chr(bsr(red, 8)); gLUT[255 - i] := chr(bsr(green, 8)); bLUT[255 - i] := chr(bsr(blue, 8)); end; theRect := empty; loPlane := 0; hiPlane := 0; data := PicBaseAddr; rowBytes := BytesPerRow; FileName := title; vRefNum := vRef; dirty := changes; selectBBox := roi; hostSig := 'Imag'; hostProc := nil; {@DummyProc} duoToneInfo := nil; thePlane := 0; monitor.gamma := 0; for i := 0 to 255 do reserved[i] := chr(0); end; ProgressMsg := 'Exporting ImageÉ'; CallCode(ExportPrepare, @ExportRec, ExportData, result, codePtr); if (result <> 0) then begin abort(result); exit(LoadExportPlugIn); end; CallCode(ExportStart, @ExportRec, ExportData, result, codePtr);{call main dialog box etc.} if (result <> 0) then begin abort(result); exit(LoadExportPlugIn); end; ShowWatch; repeat if BadRect then begin abort(0); exit(LoadExportPlugIn); end; with ExportRec, info^ do begin offset := theRect.top * BytesPerRow + theRect.left; data := ptr(ord4(PicBaseAddr) + offset); end; CallCode(exportContinue, @exportRec, exportData, result, codePtr); until (result <> 0) or EmptyRect(exportRec.theRect); CallCode(ExportFinish, @ExportRec, ExportData, result, codePtr); CloseResFile(RefNum); if MeterWindow <> nil then begin DisposeWindow(MeterWindow); MeterWindow := nil; end; InvertPic; end; procedure RunExportPlugIn (item: integer); var name: str255; begin if nExportPlugIns = 0 then begin PutPlugInMsg('No export'); exit(RunExportPlugIn); end; GetMenuItemText(ExportMenuH, item, name); LoadExportPlugIn(name); end; procedure LoadFilterPlugIn (FileName: str255); const filterAbout = 0; filterParameters = 1; filterPrepare = 2; filterStart = 3; filterContinue = 4; filterFinish = 5; GrayScaleMode = 1; var thiserror: qderr; codePtr: ProcPtr; result, i, selector, width, height: integer; ok: boolean; dst: ptr; Empty, roi: rect; offset: LongInt; procedure InvertUndoPic; var tPort: GrafPtr; SaveGDevice: GDHandle; begin SaveGDevice := GetGDevice; SetGDevice(osGDevice); GetPort(tPort); with UndoInfo^ do begin SetPort(GrafPtr(osPort)); InvertRect(PicRect); end; SetPort(tPort); SetGDevice(SaveGDevice); end; procedure abort; begin CloseResFile(RefNum); InvertPic; InvertUndoPic; if MeterWindow <> nil then begin DisposeWindow(MeterWindow); MeterWindow := nil; end; {exit(LoadFilterPlugIn);} {ppc-bug} end; function BadRect: boolean; begin BadRect := false; with info^.PicRect do begin if (FilterRec.inRect.left < left) or (FilterRec.inRect.right > right) or (FilterRec.inRect.top < top) or (FilterRec.inRect.bottom > bottom) then BadRect := true; if (FilterRec.outRect.left < left) or (FilterRec.outRect.right > right) or (FilterRec.outRect.top < top) or (FilterRec.outRect.bottom > bottom) then BadRect := true; end; end; begin {LoadFilterPlugIn} if not isSystem7 then exit(LoadFilterPlugIn); if macro then if FileName = 'Reset' then begin FilterRec.parameters := nil; exit(LoadFilterPlugIn); end; if NotInBounds or NoUndo or NotRectangular then exit(LoadFilterPlugIn); with info^ do if RoiShowing then roi := RoiRect else roi := PicRect; KillRoi; SetupUndo; SetupUndoInfoRec; InvertPic; InvertUndoPic; WhatToUndo := UndoFilter; ShowProgress := true; codePtr := nil; LoadCodeResource(FileName, '8BFM', codePtr); if codePtr = nil then exit(LoadFilterPlugIn); if TestAbortProc=nil then TestAbortProc := NewRoutineDescriptor(@TestAbort, uppTestAbortProcInfo, GetCurrentISA); if UpdateProgressProc=nil then UpdateProgressProc := NewRoutineDescriptor(@UpdateProgress, uppUpdateProgressProcInfo, GetCurrentISA); SetRect(Empty, 0, 0, 0, 0); with FilterRec, info^ do begin serialnumber := 12345; AbortProc := TestAbortProc; ProgressProc := UpdateProgressProc; with PicRect, fImageSize do begin h := right - left; v := bottom - top; end; planes := 1; filterRect := roi; background := WhiteRGB; foreground := BlackRGB; maxSpace := PixMapSize; bufferSpace := 0; inRect := Empty; inLoPlane := 0; inHiPlane := 0; outRect := Empty; outLoPlane := 0; outHiPlane := 0; inData := UndoBuf; inRowBytes := BytesPerRow; outData := PicBaseAddr; outRowBytes := BytesPerRow; isFloating := false; haveMask := false; autoMask := false; maskRect := Empty; maskData := nil; maskRowBytes := BytesPerRow; for i := 0 to 3 do begin backColor[i] := chr(BackgroundIndex); foreColor[i] := chr(ForegroundIndex); end; hostSig := 'Imag'; hostProc := nil; {@DummyProc} imageMode := GrayScaleMode; imageHRes := bsl(72, 16); imageVRes := imageHRes; floatCoord.h := 0; floatCoord.v := 0; wholeSize := fImageSize; monitor.gamma := 0; for i := 0 to 255 do reserved[i] := chr(0); end; ProgressMsg := 'Filtering ImageÉ'; if not (macro and (FilterRec.parameters <> nil)) then begin CallCode(FilterParameters, @FilterRec, filterData, result, codePtr); if result <> 0 then begin abort; exit(LoadFilterPlugIn); end; end; CallCode(FilterPrepare, @FilterRec, filterData, result, codePtr); if result <> 0 then begin abort; exit(LoadFilterPlugIn); end; if FilterRec.bufferSpace > (MaxBlock + MinFree) then begin PutError('Not enough memory to run filter.'); abort; exit(LoadFilterPlugIn); end; CallCode(FilterStart, @FilterRec, filterData, result, codePtr); if result <> 0 then begin abort; exit(LoadFilterPlugIn); end; ShowWatch; repeat if BadRect then begin abort; exit(LoadFilterPlugIn); end; with FilterRec, info^ do begin offset := inRect.top * BytesPerRow + inRect.left; inData := ptr(ord4(UndoBuf) + offset); offset := outRect.top * BytesPerRow + outRect.left; outData := ptr(ord4(PicBaseAddr) + offset); end; CallCode(filterContinue, @FilterRec, filterData, result, codePtr); until (result <> 0) or (EmptyRect(FilterRec.inRect) and EmptyRect(FilterRec.outRect)); CallCode(filterFinish, @FilterRec, filterData, result, codePtr); CloseResFile(RefNum); if MeterWindow <> nil then begin DisposeWindow(MeterWindow); MeterWindow := nil; end; InvertPic; InvertUndoPic; UpdatePicWindow; info^.changes := true; end; procedure RunFilterPlugIn (item: integer); var name: str255; begin if nFilterPlugIns = 0 then begin PutPlugInMsg('No filter'); exit(RunFilterPlugIn); end; GetMenuItemText(FilterMenuH, item, name); LoadFilterPlugIn(name); end; end.